home *** CD-ROM | disk | FTP | other *** search
/ HyperLib 1997 Winter - Disc 1 / HYPERLIB-1997-Winter-CD1.ISO.7z / HYPERLIB-1997-Winter-CD1.ISO / オンラインウェア / UTIL / Alpha 6.5.sit / Tcl / Menus / eudoraMenu.tcl < prev    next >
Text File  |  1996-08-15  |  23KB  |  875 lines
  1. #     <nowrap>
  2. # Built for Eudora
  3.  
  4. # Class message: A message
  5. # Elements:
  6. #     field by name
  7. # Properties:
  8. #     body  string  -- the body of the message
  9. #     priority  integer  -- the priority
  10. #     label  integer  -- the index of the label
  11. #     status  unread/already read/replied/forwarded/redirected/not sendable/sendable/queued/sent/never sent  -- the message status
  12. #     sender  string  -- the sender as appearing in the message summary
  13. #     date  string  [r/o]  -- the date as appearing in the message summary
  14. #     subject  string  -- the subject as appearing in the message summary
  15. #     size  integer  [r/o]  -- the size of the message
  16. #     outgoing  boolean  [r/o]  -- is the message is outgoing?
  17. #     signature  none/standard/alternate  -- which signature the message should have
  18. #     QP  boolean  -- is Eudora allowed to encode text?
  19. #     return receipt  boolean  -- is a return receipt is requested?
  20. #     wrap  boolean  -- should the text be wrapped when sent?
  21. #     tab expansion  boolean  -- should tabs get expanded to spaces?
  22. #     keep copy  boolean  -- should a copy should be kept after message is sent?
  23. #     preserve macintosh info  boolean  -- should Macintosh information always be sent with attachments?
  24. #     attachment encoding  AppleDouble/AppleSingle/BinHex/uuencode  -- the type of encoding to use for attachments
  25. #     show all headers  boolean  -- should all headers be visible?
  26. #     transliteration table  integer  -- the resource id of the transliteration table
  27. #     will be fetched  boolean  -- will the message be [re]fetched on next check?
  28. #     will be deleted  boolean  -- will the message be deleted from server on next check?
  29. # 
  30.  
  31. if $startingUp {
  32.     set mailMenu         "･138"
  33.     addMenu mailMenu
  34.     return
  35. }
  36.  
  37.  
  38.  
  39. proc mailMenu {} {}
  40. proc dummyMail {} {}
  41.  
  42.  
  43. addMode Mail dummyMail {} mailMenu
  44.  
  45. if {![info exists trashName]} {set trashName "Trash"}
  46.  
  47. newModeVar Mail wordBreak {(¥$)?[a-zA-Z0-9_.]+} 0
  48. newModeVar Mail wordWrap {0} 1
  49. newModeVar Mail wordBreakPreface {[^a-zA-Z0-9_¥$]} 0
  50. newModeVar Mail autoMark    0    1
  51. set mailKeywords {{Subject:} {To:} {From:} {Cc:} {Date:} {Sender:}}
  52. regModeKeywords -k blue -e {>} Mail $mailKeywords
  53.  
  54.  
  55. #================================================================================
  56.  
  57.  
  58. #===============================================================================
  59. newModeVar Mail tossOnQueue        1    1
  60. newModeVar Mail    switchOnQueue    0    1
  61. #===============================================================================
  62. # Utility routines.
  63. proc eudoraFolder {} { nameObject euMF {'TEXT'()} [nullObject] }
  64. proc mailboxByName {name} { nameObject euMB "ﾒ$nameﾓ" [eudoraFolder] }
  65. proc mailboxByIndex {ind} { indexObject euMB $ind [eudoraFolder] }
  66. proc eudoraMessage {msg_id mailbox} { indexObject euMS $msg_id [mailboxByName $mailbox] }
  67. proc mailboxProperty {prop mailbox} { objectProperty 'CSOm' $prop [mailboxByName $mailbox] }
  68. proc messageProperty {prop msg_id mailbox} { objectProperty 'CSOm' $prop [eudoraMessage $msg_id $mailbox] }
  69.  
  70. # Get path-name for indicated mailbox
  71. proc mailboxPathName {name} {
  72.     extractPath [mailboxProperty euFS $name]
  73. }
  74.  
  75. proc mailboxPathIndex {ind} {
  76.     set res [objectProperty 'CSOm' euFS [mailboxByIndex $ind]]
  77.     return [extractPath $res]
  78. }
  79.  
  80. #===============================================================================
  81.  
  82.  
  83. proc checkMailPath {} {
  84.     set name [nameFromAppl CSOm]
  85.     launch $name
  86.     return [file tail $name]
  87. }
  88.  
  89. if {![info exists eudoraBoxes]} {
  90.     set eudoraBoxes {In Out}
  91. }
  92.  
  93. menu -n $mailMenu -p eudoraProc {
  94.     "<SbackgroundEudora"
  95.     "<Seudora"
  96.     "help"
  97.     "palette"
  98.     "(-"
  99.     "/e<UnewMessage"
  100.     "cc"
  101.     "bcc"
  102.     "(-"
  103.     "/f<Usend"
  104.     "/g<Ureply"
  105.     "(-"
  106.     "/,<SfinishNickname"
  107.     "/,<S<O<IsubstituteNickname"
  108.     "editNicknames"
  109.     "updateNicknames"
  110.     "(-"
  111.     "updateMailboxLists"
  112.     {menu -n open -p mailBoxProc -m {}}
  113.     {menu -n moveTo -p transferProc -m {}}
  114.     "(-"
  115.     {menu -n tellEudora -p eudoraProc {
  116.         "/k<UflushOutbox"
  117.         "/l<UcheckForMail"
  118.         "(-"
  119.         startNotifying
  120.         stopNotifying}}
  121.     {menu -n mailFlags -p mailFlagsProc {alertOnIncoming flushOnCheck immediateSend -- trashName}}
  122. }
  123. menu -n open -p mailBoxProc -m [concat [list "/h<UOpen Mailboxﾉ" "(-"] $eudoraBoxes]
  124. menu -n moveTo -p transferProc -m [concat [list "/i<UMove To Trash" "/j<UMove To Mailboxﾉ" "(-"] $eudoraBoxes]
  125.  
  126. if {![info exists eudoraNicknames] && [file exists "[file dirname [file dirname $PREFS]]:Eudora Folder:Eudora Nicknames"]} {
  127.     set eudoraNicknames "[file dirname [file dirname $PREFS]]:Eudora Folder:Eudora Nicknames"
  128. }
  129.  
  130.  
  131. proc updateNicknames {{arg ""}} {
  132.     global euNicknames eudoraNicknames
  133.     
  134.     if {![info exists eudoraNicknames] || ![file exists $eudoraNicknames]} {
  135.         if {![string length $arg]} {
  136.             alertnote {Please locate the file "Eudora Nicknames" via "Config:App Paths".}
  137.         }
  138.         return
  139.     }
  140.     
  141.     set fd [open $eudoraNicknames]
  142.     foreach a [split [read $fd] "¥n"] {
  143.         if {[llength $a]} {
  144.             set euNicknames([lindex $a 1]) [lindex $a 2]
  145.         }
  146.     }
  147.     close $fd
  148. }
  149. updateNicknames quiet
  150.  
  151.  
  152. proc finishNickname {} {
  153.     global euNicknames
  154.     set pos [getPos]
  155.     backwardWord
  156.     set text [getText [getPos] $pos]
  157.     goto $pos
  158.     foreach w [array names euNicknames] {
  159.         if {[string match "$text*" $w]} {
  160.             lappend matches $w
  161.         }
  162.     }
  163.     if {![llength $matches]} {
  164.         beep
  165.     } else {
  166.         insertText [string range [largestPrefix $matches] [string length $text] end]
  167.     }
  168. }    
  169.  
  170.  
  171. proc editNicknames {} {
  172.     global eudoraNicknames
  173.     
  174.     edit "$eudoraNicknames"
  175. }
  176.  
  177.  
  178. proc substituteNickname {} {
  179.     global euNicknames
  180.     finishNickname
  181.     set to [getPos]
  182.     backwardWord
  183.     set from [getPos]
  184.     set text [getText $from $to]
  185.     goto $to
  186.  
  187.     if {[info exists euNicknames($text)]} {
  188.         replaceText $from $to [set euNicknames($text)]
  189.     }
  190. }
  191.  
  192. proc openMailbox {} {
  193.     global eudoraBoxes eudoraLastFolder modifiedVars
  194.     if {[info exists eudoraLastFolder]} {
  195.         set fold $eudoraLastFolder
  196.     } else {
  197.         set fold [lindex $eudoraBoxes 0]
  198.     }
  199.     set eudoraLastFolder [sPromptChoices "Open mailbox" $fold $eudoraBoxes]
  200.     mailBoxProc dummy $eudoraLastFolder
  201.     lappend modifiedVars eudoraLastFolder
  202. }
  203.  
  204.  
  205. proc moveToFolderProc {curr c} {
  206.     global eudoraBoxes
  207.     if {$c != "¥t"} {return $c}
  208.     
  209.     set matches {}
  210.     foreach w $eudoraBoxes {
  211.         if {[string match "$curr*" $w]} {
  212.             lappend matches $w
  213.         }
  214.     }
  215.     if {![llength $matches]} {
  216.         beep
  217.     } else {
  218.         return [string range [largestPrefix $matches] [string length $curr] end]
  219.     }
  220.     return ""
  221. }
  222.  
  223.  
  224. proc moveToMailbox {} {
  225.     global eudoraLastFolder modifiedVars trashName
  226.     
  227.     if {[info exists eudoraLastFolder]} {
  228.         set fold $eudoraLastFolder
  229.     } else {
  230.         set fold $trashName
  231.     }
  232.     
  233.     set folder [statusPrompt -f "Move to ($fold): " moveToFolderProc]
  234.     if {[string length $folder]} {
  235.         doFolderMove $folder
  236.         set eudoraLastFolder $folder
  237.         lappend modifiedVars eudoraLastFolder
  238.     } else {
  239.         doFolderMove $fold
  240.     }
  241. }
  242.  
  243.  
  244. proc eudoraProc {menu item} {
  245.     global HOME mailMenu
  246.  
  247.     switch $item {
  248.         "eudora"        {launchForeAppl CSOm}
  249.         "backgroundEudora"        {launch [nameFromAppl CSOm]}
  250.         "help"            {edit -r "$HOME:Help:Eudora"}
  251.         "palette"        {float -m $mailMenu -M 2 -n Eudora}
  252.         "cc"            {eudoraCc}
  253.         "bcc"            {eudoraBcc}
  254.         "newMessage"    {mailNewMsg}
  255.         "reply"            {mailReplymsg}
  256.         "send"            {checkMailPath; mailSendCreatedMsg}
  257.         "flushOutbox"    {checkMailPath; mailFlushOut}
  258.         "checkForMail"    {checkMailPath; mailCheck}
  259.         "startNotifying" "checkMailPath; startNotifying"
  260.         "stopNotifying"    "checkMailPath; stopNotifying"
  261.         "moveToTrash"    {mailTrashmsg}
  262.         "Move To Trash"    {mailTrashmsg}
  263.         "Create New"    {eudoraNewMailbox}
  264.         "Delete"        {eudoraDeleteMailbox}
  265.         default            $item
  266.     }
  267. }
  268.  
  269. if {![info exists mailflushOnCheck]} {set mailflushOnCheck 1}
  270. if {![info exists mailalertOnIncoming]} {set mailalertOnIncoming 1}
  271. if {![info exists mailimmediateSend]} {set mailimmediateSend 0}
  272. markMenuItem mailFlags flushOnCheck $mailflushOnCheck
  273. markMenuItem mailFlags alertOnIncoming $mailalertOnIncoming
  274. markMenuItem mailFlags immediateSend $mailimmediateSend
  275.  
  276.  
  277. proc mailFlagsProc {menu flag} {
  278.     global mail$flag modifiedVars trashName
  279.  
  280.     if {$flag == "trashName"} {
  281.         set trashName [prompt "Trash folder name:" $trashName]
  282.         lappend modifiedVars trashName
  283.         return
  284.     }
  285.     
  286.  
  287.     set mail$flag [expr 1 - [set mail$flag]]
  288.     lappend modifiedVars mail$flag
  289.     markMenuItem mailFlags $flag [set mail$flag]
  290. }
  291.  
  292.  
  293. proc mailBoxProc {menu item} {
  294.     global inboxMembers ALPHA eudoraBoxes modifiedVars
  295.     global tileLeft tileTop tileHeight errorHeight defWidth
  296.  
  297.     if {$item == "Open Mailbox"} {
  298.         return [openMailbox]
  299.     }
  300.     
  301.     killMailboxWindow
  302.  
  303.     checkMailPath
  304.     switchTo $ALPHA
  305.  
  306.     global trashedMsgs$item
  307.     set trashedMsgs$item {}
  308.     
  309.     set inboxMembers {}
  310.     set text {}
  311.     set ind 1
  312.     foreach msg [mailSenders $item] {
  313.         set from [mailAddr [lindex $msg 0]]
  314.         set tag {}
  315.         while {[lsearch $inboxMembers $from$tag] >= 0} {
  316.             if {![string length $tag]} {
  317.                 set tag { <2>}
  318.             } else {
  319.                 regexp {[0-9]+} $tag tag
  320.                 set tag " <[expr $tag + 1]>"
  321.             }
  322.         }
  323.         append text [format "%-40s : %s¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥tｰ$itemｰ$ind¥r" "$from$tag" [lindex $msg 1]]
  324.         lappend inboxMembers $from$tag
  325.         incr ind
  326.     }
  327.     if {![string length $text]} {
  328.         alertnote "No messages in '$item'!"
  329.         return
  330.     }
  331.     
  332.     new -n "* MAILBOX '$item' *" -g $tileLeft $tileTop $defWidth $errorHeight
  333.     global winModes
  334.     set name [lindex [winNames] 0]
  335.     changeMode [set winModes($name) Brws]
  336.  
  337.     insertText "(<cr> to go to message)¥r-----¥r$text"
  338.     
  339.     select [nextLineStart [nextLineStart 0]] [nextLineStart [nextLineStart [nextLineStart 0]]]
  340.     setWinInfo dirty 0
  341.     setWinInfo read-only 1
  342.     message ""
  343. }
  344.  
  345. proc eudoraNewMailbox {} {
  346. }
  347.  
  348.  
  349. proc eudoraDeleteMailbox {} {
  350. }
  351.  
  352.  
  353. proc killMailboxWindow {} {
  354.     if {[set ind [lsearch [winNames] {*MAILBOX*}]] >= 0} {
  355.         set win [lindex [winNames] $ind]
  356.         bringToFront $win
  357.         killWindow
  358.     }
  359. }
  360.  
  361.  
  362. proc mailGotoMatch {} {
  363.     if {[regexp {ｰ(.+)ｰ([0-9]+)} [getText [lineStart [getPos]] [nextLineStart [getPos]]] dummy folder ind]} {
  364.         global trashedMsgs$folder
  365.         
  366.         set deleted 0
  367.         for {set i 1} {$i < $ind} {incr i} {
  368.             if {[lsearch [set trashedMsgs$folder] $i] >= 0} {
  369.                 incr deleted
  370.             }
  371.         }
  372.         mailOpen $folder [expr $ind - $deleted] $ind
  373.     }
  374. }
  375.  
  376.  
  377. proc mailAddr {name} {
  378.     if {![regexp {<(.*)>} $name dummy addr]} {
  379.         regexp {^[^ ]+} $name addr
  380.     }
  381.     return $addr
  382. }
  383.  
  384.  
  385. proc mailSenders {folder} {
  386.     set cnt [mailCountMsgs $folder]
  387.     set msgs {}
  388.     for {set i 1} {$i <= $cnt} {incr i} {
  389.         set subject {}
  390.         if {![regexp -nocase {From: (.*)} [mailGetField from $folder $i] dummy from]} {
  391.             error "No from field!"
  392.         }
  393.         regexp {Subject: (.*)} [mailGetField subject $folder $i] dummy subject
  394.         lappend msgs [list $from $subject]
  395.     }
  396.     return $msgs
  397. }    
  398.  
  399.  
  400. proc eudoraCc {} {
  401.     if {![catch {set res [search -s -f 1 -r 1 -i 1 {cc:.*} 0]}]} {
  402.         goto [lindex $res 0]
  403.         endOfLine
  404.     } else {
  405.         beginningOfBuffer
  406.         nextLine
  407.         insertText "Cc: ¥r"
  408.         backwardChar
  409.     }
  410. }
  411.  
  412.  
  413. proc eudoraBcc {} {
  414.     if {![catch {set res [search -s -f 1 -r 1 -i 1 {bcc:.*} 0]}]} {
  415.         goto [lindex $res 0]
  416.         endOfLine
  417.     } else {
  418.         beginningOfBuffer
  419.         nextLine
  420.         insertText "Bcc: ¥r"
  421.         backwardChar
  422.     }
  423. }
  424.  
  425.  
  426. proc mailFlushOut {} {
  427.     global MailmodeVars
  428.     message "Telling Eudora to flush messagesﾉ"
  429.  
  430.     AEBuild 'CSOm' CSOm eCon eSen bool(ﾇ01ﾈ) eChk bool(ﾇ00ﾈ)
  431.     message ""
  432. }
  433.  
  434.  
  435. proc mailCheck {} {
  436.     global MailmodeVars mailflushOnCheck
  437.     message "Told Eudora to check for new mailﾉ"
  438.  
  439.     AEBuild 'CSOm' CSOm eCon eSen bool(ﾇ0$mailflushOnCheckﾈ) eChk bool(ﾇ01ﾈ)
  440. }
  441.  
  442.  
  443. proc mailReplymsg {} {
  444.     global inboxMembers
  445.  
  446.     set prefix "> "
  447.     set res [search -s -f 1 -r 1 {^>==} 0]
  448.     set header [getText 0 [lindex $res 0]]
  449.     
  450.     set from [mailGetFrom]
  451.     if {![regexp {Subject: ([^¥r]*)} $header dummy subject]} {set subject ""}
  452.     set body [getText [expr [lindex $res 1] + 1] [maxPos]]
  453.  
  454.     regsub -all "¥r" $body "¥r$prefix" body
  455.     mailNewMsg $from "Re: $subject" "¥r$prefix$body¥r"
  456. }
  457.  
  458. proc transferProc {menu item} {
  459.     if {$item == "Move To Trash"} {
  460.         mailTrashmsg
  461.     } elseif {$item == "Move To Mailbox"} {
  462.         moveToMailbox
  463.     } else {
  464.         doFolderMove $item
  465.     }
  466. }
  467.  
  468.  
  469. proc mailTrashmsg {} {
  470.     global trashName
  471.     doFolderMove $trashName
  472. }
  473.  
  474. proc doFolderMove {toFolder} {
  475.     # Is this a summary or msg window?
  476.     if {[regexp "MAILBOX" [lindex [winNames] 0]]} {
  477.         if {![regexp {ｰ(.*)ｰ([0-9]+)} [getText [getPos] [nextLineStart [getPos]]] dummy folder orig]} {
  478.             beep
  479.             return
  480.         }
  481.         if {$toFolder == $folder} return
  482.         global trashedMsgs$folder
  483.  
  484.         set deleted 0
  485.         for {set i 1} {$i < $orig} {incr i} {
  486.             if {[lsearch [set trashedMsgs$folder] $i] >= 0} {
  487.                 incr deleted
  488.             }
  489.         }
  490.         set number [expr $orig - $deleted]
  491.         set summary 1
  492.     } else {
  493.         set pos [lindex [search -f 1 -r 1 {^Msg} 0] 0]
  494.         set text [getText $pos [nextLineStart $pos]]
  495.         regexp {"([^"]+)" ¥(([0-9]+)¥).*"([^"]+)"} $text dummy number orig folder
  496.         if {$toFolder == $folder} return
  497.         set summary 0
  498.  
  499.         global trashedMsgs$folder
  500.     }
  501.     
  502.     message "Moving msg $number ($orig) of folder '$folder' to '$toFolder'"
  503.     moveMsg $number $folder $toFolder
  504.     if {!$summary} killWindow
  505.  
  506.     lappend trashedMsgs$folder $orig
  507.     
  508.     # Find summary info and delete it
  509.     set win [lindex [winNames] 0]
  510.     if {[regexp "MAILBOX" $win]} {
  511.         setWinInfo read-only 0
  512.     
  513.         set inds [search -f 1 -r 1 "ｰ$folderｰ$orig¥$" 0]
  514.         set pos [lindex $inds 0]
  515.         deleteText [lineStart $pos] [nextLineStart $pos]
  516.     
  517.         if {[string length [search -n -f 1 -r 0 {ｰ} 0]]} {
  518.             setWinInfo dirty 0
  519.             setWinInfo read-only 1
  520.     
  521.             nextLine
  522.             upBrowse
  523.         } else {
  524.             setWinInfo dirty 0
  525.             killWindow
  526.         }
  527.     }
  528. }
  529.  
  530.     
  531. proc mailGetFrom {} {
  532.     set res [search -s -f 1 -r 1 {>==} 0]
  533.     set header [getText 0 [lindex $res 0]]
  534.     if {[regexp {From: ([^¥r]*)} $header dummy from]} {
  535.         return [mailAddr $from]
  536.     }
  537.     error "No from line"
  538. }
  539.  
  540.     
  541.  
  542. proc mailSendCreatedMsg {} {
  543.     global MailmodeVars mailimmediateSend
  544.     
  545.     set name [checkMailPath]
  546.     set res [search -s -f 1 -r 0 {>==text follows this line==<} 0]
  547.     set header [getText 0 [lindex $res 0]]
  548.     
  549.     if {![regexp {To: ([^¥r]*)} $header dummy to]} {set to ""}
  550.     if {![regexp {Cc: ([^¥r]*)} $header dummy cc]} {set cc ""}
  551.     if {![regexp {Subject: ([^¥r]*)} $header dummy subject]} {set subject ""}
  552.  
  553.     set body [getText [expr [lindex $res 1] + 1] [maxPos]]
  554.     
  555.     mailCreateMsg
  556.     mailSetField to $to
  557.     mailSetField cc $cc
  558.     mailSetField subject $subject
  559.     mailSetField "" $body
  560.     
  561.     if {$MailmodeVars(tossOnQueue)} {
  562.         setWinInfo dirty 0
  563.         killWindow
  564.     }
  565.  
  566.     mailQueueLast
  567.  
  568.     if {$MailmodeVars(switchOnQueue)} {
  569.         switchTo $name
  570.     }
  571.  
  572.     if {$mailimmediateSend} {
  573.         mailFlushOut
  574.     } else {
  575.         message "Message queuedﾉ"
  576.     }
  577. }
  578.  
  579.     
  580. proc mailNewMsg {{to ""} {subject ""} {body ""}} {
  581.     new -n "New Mail"
  582.     global winModes
  583.     set name [lindex [winNames] 0]
  584.     changeMode [set winModes($name) Mail]
  585.  
  586.     insertText "To: $to¥rSubject: $subject¥r>==text follows this line==<¥r$body"
  587.     setWinInfo dirty 0
  588.     goto 0
  589.     centerRedraw
  590.     mailTab
  591. }
  592.  
  593.  
  594. proc mailTab {} {
  595.     global mailKeywords
  596.     if {[catch {search -s -f 1 -r 1 -i 1 "([join $mailKeywords {|}]|^>)" [getPos]} res]} {
  597.         insertText "¥t"
  598.         return
  599.     }
  600.     if {[lookAt [lindex $res 0]] == ">"} {
  601.         select [nextLineStart [lindex $res 1]] [maxPos]
  602.     } else {
  603.         goto [expr [lindex $res 1] + 1]
  604.         endLineSelect
  605.     }
  606. }
  607. bind '¥t'                         mailTab Mail
  608.  
  609.  
  610. proc mailOpen {folder i originalNum} {
  611.     global tileLeft tileTop tileHeight trashedMsgs$folder defWidth
  612.     
  613.     set from [mailGetField From $folder $i]
  614.     set to [mailGetField To $folder $i]
  615.     set subject [mailGetField Subject $folder $i]
  616.     set sender [mailGetField Sender $folder $i]
  617.     set date [mailGetField Date $folder $i]
  618.     set cc [mailGetField cc $folder $i]
  619.     set contents [mailGetField "" $folder $i]
  620.     
  621. #===============================================================================
  622.     global tileHeight tileTop tileLeft errorHeight errorDisp defWidth
  623.     set top $tileTop
  624.     set geo [getGeometry]
  625.     if {([lindex $geo 0] != $tileLeft) || ([lindex $geo 1] != $top) || ([lindex $geo 2] != $defWidth) || ([lindex $geo 3] != $errorHeight) } {
  626.         moveWin $tileLeft $top
  627.         sizeWin $defWidth $errorHeight
  628.     }
  629.     set mar 28
  630.     incr top [expr $errorHeight + $mar]
  631. #===============================================================================
  632.     new -n "MAIL" -g $tileLeft $top $defWidth [expr $errorDisp - 5]
  633.  
  634.     global winModes
  635.     set name [lindex [winNames] 0]
  636.     changeMode [set winModes($name) Mail]
  637.  
  638.     set text {}
  639.     if {[string length $subject]} {append text "$subject¥r"}
  640.     if {[string length $to]} {append text "$to¥r"}
  641.     if {[string length $from]} {append text "$from¥r"}
  642.     if {[string length $date]} {append text "$date¥r"}
  643.     if {[string length $cc]} {append text "$cc¥r"}
  644.     if {[string length $sender]} {append text "$sender¥r"}
  645.     append text "Msg ¥"$i¥" ($originalNum) of mailbox ¥"$folder¥"     Reply     Trash¥r"
  646.     insertText "${text}>===============================================================================
  647. $contents
  648. "
  649.     goto 0
  650.     goto [lindex [search -f 1 -r 1 {^Msg "} 0] 0]
  651.     set pos [getPos]
  652.     regexp -indices {([0-9]+).*mailbox "(.+)".*(Reply).*(Trash)} [getText $pos [nextLineStart $pos]] dummy num fold rep tra
  653.     colorSelectPos [expr $pos + [lindex $num 0]] [expr 1 + $pos + [lindex $num 1]] bold 12
  654.     colorSelectPos [expr $pos + [lindex $fold 0]] [expr 1 +$pos + [lindex $fold 1]] bold 12
  655.     hyperSelectPos [expr $pos + [lindex $rep 0]] [expr 1 +$pos + [lindex $rep 1]] "mailReplymsg"
  656.     hyperSelectPos [expr $pos + [lindex $tra 0]] [expr 1 +$pos + [lindex $tra 1]] "mailTrashmsg"
  657.  
  658.     goto 0
  659.     setWinInfo dirty 0
  660.     setWinInfo read-only 1
  661.     centerRedraw
  662. }
  663.  
  664. proc colorSelectPos {from to ind ind2} {
  665.     insertColorEscape $from $ind
  666.     insertColorEscape $to $ind2
  667. }
  668.  
  669. proc hyperSelectPos {from to text} {
  670.     if {$from == $to} {
  671.         beep
  672.         return
  673.     }
  674.     insertColorEscape $from 3
  675.     insertColorEscape $from 15 $text
  676.     insertColorEscape $to 12
  677.     insertColorEscape $to 0
  678. }
  679.  
  680. proc mailFixMenus {} {
  681.     global mailMenu
  682.     
  683.     set ins {}
  684.     set outs {}
  685.     
  686.     set cnt [mailCountMsgs in]
  687.     for {set i 1} {$i <= $cnt} {incr i} {
  688.         lappend ins [mailGetField from in $i]
  689.     }
  690.     menu -n in {}
  691.     foreach item $ins {
  692.         addMenuItem -l "" in $item
  693.     }
  694.     
  695.     set cnt [mailCountMsgs out]
  696.     for {set i 1} {$i <= $cnt} {incr i} {
  697.         lappend outs [mailGetField from out $i]
  698.     }
  699.     menu -n out {}
  700.     foreach item $outs {
  701.         addMenuItem -l "" out $item
  702.     }
  703. }
  704.  
  705.  
  706. # make message at end of mailbox "out" of mail folder ""
  707. proc mailCreateMsg {} {
  708.     createThingAtEnd 'CSOm' [mailboxByName Out] euMS
  709. }
  710.  
  711.  
  712. # Move msg w/ specified index between folders, including to Trash.
  713. proc moveMsg {msg infolder outfolder} {
  714.     AEBuild -r 'CSOm' core move {----} "obj ¥{form:indx, want:type(euMS), seld:$msg, from:obj ¥{form:name, want:type(euMB), seld:ﾒ$infolderﾓ, from:obj ¥{form:name, want:type(euMF), seld:'TEXT'(), from:'null'()¥}¥}¥}" {insh} "insl¥{kobj:obj ¥{form:name, want:type(euMB), seld:ﾒ$outfolderﾓ, from:obj ¥{form:name, want:type(euMF), seld:'TEXT'(), from:'null'()¥}¥}, kpos:end ¥}"
  715. }
  716.  
  717.  
  718. # set field "fld" of message 0 to "to"
  719. proc mailSetField {fld to} {
  720.     AEBuild -r 'CSOm' core setd {----} "obj ¥{form:name, want:type(euFd), seld:ﾒ$fldﾓ, from:obj ¥{form:indx, want:type(euMS), seld:1, from:'null'()¥}¥}" data "ﾒ$toﾓ"
  721. }
  722.  
  723. proc mailGetField {field folder msg} {
  724.     if {[catch {getObjectData 'CSOm' euFd $field [eudoraMessage $msg $folder]} res]} {
  725.         return ""
  726.     } else {
  727.         return $res
  728.     }
  729. }
  730.  
  731. # obj {want:type('prop'), from:obj {form:indx, want:type(euMS), seld:$msg, from:obj {form:name, want:type(euMB), seld:ﾒ$folderﾓ, from:obj {form:name, want:type(euMF), seld:'TEXT'(), from:'null'()}}}, form:'prop', seld:type('euST')}
  732.  
  733. proc mailMsgStatus {folder msg} {
  734.     if {[catch {AEBuild -r 'CSOm' core getd {----} "obj ¥{want:type('prop'), from:obj ¥{form:indx, want:type(euMS), seld:$msg, from:obj ¥{form:name, want:type(euMB), seld:ﾒ$folderﾓ, from:obj ¥{form:name, want:type(euMF), seld:'TEXT'(), from:'null'()¥}¥}¥}, form:'prop', seld:type('euST')¥}"} text]} {
  735.         return ""
  736.     }
  737.     set from [string first "ﾒ" $text]
  738.     set to [string first "ﾓ" $text]
  739.     return [string range $text [expr $from + 1] [expr $to - 1]]
  740. }
  741.  
  742. proc mailQueueLast {} {
  743.     AEBuild -r 'CSOm' CSOm eQue ---- {obj {form:indx, want:type(euMS), seld:1, from:'null'()}}
  744. }
  745.  
  746. # CSOm¥eAtc{'----':obj {form:indx, want:type(euMS), seld:1, from:'null'()}, eDcl:[fss (ﾇ486172643A4465736B746F7020466F6C6465723A62756773ﾈ)]}
  747. proc mailAttachmentDoesntWork {name} {
  748.     AEBuild -r 'CSOm' CSOm eAtc ---- {obj {form:indx, want:type(euMS), seld:1, from:'null'()}} eDcl [makeAlis $name]
  749. }
  750.  
  751. # core¥setd{'----':obj {form:prop, want:type(prop), seld:type(euPY), from:obj {form:indx, want:type(euMS), seld:1, from:'null'()}}, data:1}
  752. proc mailSetNumberProperty {prop to} {
  753.     AEBuild -r 'CSOm' core setd ---- "obj ¥{form:prop, want:type(prop), seld:type($prop), from:obj ¥{form:indx, want:type(euMS), seld:1, from:'null'()¥}¥}" data $to
  754. }    
  755.  
  756.  
  757. proc mailCountMsgs {mbox} {
  758.     return [countObjects 'CSOm' [mailboxByName "$mbox"]  euMS]
  759. }
  760.  
  761. proc mailCountMailboxes {} {
  762.      return [countObjects 'CSOm' [eudoraFolder] euMB]
  763. }
  764.     
  765.  
  766. proc updateMailboxLists {} {
  767.     set num [mailCountMailboxes]
  768.     for {set i 1} {$i <= $num} {incr i} {
  769.         set name [file tail [mailboxPathIndex $i]]
  770.         message $name
  771.         lappend boxes $name
  772.     }
  773.     
  774.     global eudoraBoxes modifiedVars
  775.     lappend modifiedVars eudoraBoxes
  776.     set eudoraBoxes $boxes
  777.     menu -n open -p mailBoxProc -m $eudoraBoxes
  778.     menu -n moveTo -p transferProc -m $eudoraBoxes
  779.     message "done."
  780. }
  781.  
  782.  
  783. #===============================================================================
  784.  
  785. eventHandler CSOm eNot "eudoraHandler"
  786.  
  787. # a sample 'msgs': obj {want:type(euMS), from:obj {want:type(euMB), from:obj {want:type(euMF), from:'null'(), form:name, seld:'TEXT'()}, form:name, seld:ﾒInﾓ}, form:indx, seld:18}, obj {want:type(euMS), from:obj {want:type(euMB), from:obj {want:type(euMF), from:'null'(), form:name, seld:'TEXT'()}, form:name, seld:ﾒInﾓ}, form:indx, seld:19}
  788. proc eudoraHandler {it} {
  789.     global blah mailalertOnIncoming
  790.     message ""
  791.     if {[regexp {eWHp:wArv.*¥[(obj.*)¥], &repq} $it dum1 msgs]} {
  792.         set ids [getMsgIDs $msgs]
  793.         if {$mailalertOnIncoming} {
  794.             mailBrowser In $ids
  795.             beep; beep
  796.         }
  797.     }
  798. }
  799.  
  800.  
  801. proc mailBrowser {folder ids} {
  802.     global inboxMembers ALPHA
  803.     global tileLeft tileTop defWidth tileHeight errorHeight
  804.  
  805.     checkMailPath
  806.     switchTo $ALPHA
  807.  
  808.     global trashedMsgs$folder
  809.     set trashedMsgs$folder {}
  810.     
  811.     set inboxMembers {}
  812.     set text {}
  813.  
  814.     foreach id $ids {
  815.         regexp {From: (.*)} [mailGetField from $folder $id] dummy from
  816.         set from [mailAddr $from]
  817.         set subject {}
  818.         regexp {Subject: (.*)} [mailGetField subject $folder $id] dummy subject
  819.         set tag {}
  820.         while {[lsearch $inboxMembers $from$tag] >= 0} {
  821.             if {![string length $tag]} {
  822.                 set tag { <2>}
  823.             } else {
  824.                 regexp {[0-9]+} $tag tag
  825.                 set tag " <[expr $tag + 1]>"
  826.             }
  827.         }
  828.         append text [format "%-40s : %s¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥t¥tｰInｰ$id¥r" "$from$tag" $subject]
  829.         lappend inboxMembers $from$tag
  830.     }
  831.     if {![string length $text]} {
  832.         alertnote "No messages!"
  833.         return
  834.     }
  835.     
  836.     if {[set ind [lsearch [winNames] "*Incoming MAILBOX*"]] >= 0} {
  837.         bringToFront [lindex [winNames] $ind]
  838.         setWinInfo read-only 0
  839.         endOfBuffer
  840.         insertText $text
  841.     } else {
  842.         killMailboxWindow
  843.         new -n "* Incoming MAILBOX *" -g $tileLeft $tileTop $defWidth $errorHeight
  844.         global winModes
  845.         set name [lindex [winNames] 0]
  846.         changeMode [set winModes($name) Brws]
  847.     
  848.         insertText "(<cr> to go to message)¥r-----¥r$text"
  849.     }
  850.     select [nextLineStart [nextLineStart 0]] [nextLineStart [nextLineStart [nextLineStart 0]]]
  851.     setWinInfo dirty 0
  852.     setWinInfo read-only 1
  853.     message ""
  854. }
  855.  
  856.  
  857. proc getMsgIDs {text} {
  858.     if {[regexp -indices {seld:([0-9]+)} $text dummy ind]} {
  859.         return [concat [string range $text [lindex $ind 0] [lindex $ind 1]] [getMsgIDs [string range $text [lindex $ind 1] end]]]
  860.     }
  861. }
  862.  
  863. proc startNotifying {} {
  864.     global HOME ALPHA quitHooks
  865.     
  866.     AEBuild 'CSOm' CSOm nIns ---- [makeAlis "$HOME:$ALPHA"]
  867. #     lappend quitHooks stopNotifying
  868. }
  869.  
  870. proc stopNotifying {} {
  871.     global HOME ALPHA
  872.     
  873.     AEBuild 'CSOm' CSOm nRem ---- [makeAlis "$HOME:$ALPHA"]
  874. }
  875.